home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / grille.AmiCAD < prev    next >
Text File  |  1998-04-25  |  4KB  |  186 lines
  1. /* Création d'une grille quadrillée
  2. $VER: Grille.AmiCAD 1.02 (© R.Florac, 26/04/98)
  3. Version 1.00 ©R.Florac, Mardi 3 Mars 1998
  4. Version 1.01, 25 avril 1998 (utilisation d'un rectangle pour définir la zone recevant la grille) */
  5.  
  6. options results     /* indispensable pour récupérer le résultat des macros */
  7.  
  8. signal on error     /* pour l'interception des erreurs */
  9. signal on syntax
  10.  
  11. 'WWIDTH(-1)'; lt = result
  12. 'WHEIGHT(-1)'; ht=result
  13. clip=-1
  14. FIRSTSEL; obj=result
  15. if obj>0 then do
  16.     'TYPE(FIRSTSEL)'; type=result
  17.     if type=22 then do
  18.     'CLIPUNIT(5)'; clip=result
  19.     'COORDS(FIRSTSEL)'; coords=result
  20.     PARSE VAR coords x0 ',' y0 ',' x1 ',' y1
  21.     xg=minima(x0,x1); xd=maxima(x0,x1)
  22.     yh=minima(y0,y1); yb=maxima(y0,y1)
  23.     l=xd-x0+1; h=yb-y0+1
  24.     'NEXTSEL('obj')'; obj=result
  25.     end
  26. end
  27. else obj=1
  28.  
  29. if obj>0 then do
  30.     'MESSAGE("Dessinez et sélectionnez"+CHR(10)+"un rectangle dans"+CHR(10)+"lequel doit être"+CHR(10)+"intégrée la grille")'
  31.     call quitter
  32. end
  33.  
  34. 'ASK("Axe horizontal"+CHR(10)+"Nombre de décades?")'
  35. ndh = result
  36. if ndh<=0 then call quitter
  37. 'SELECT("Type d''échelle"+CHR(10)+"1- Linéaire"+CHR(10)+"2- Logarithmique"+CHR(10)+"3- Antilogarithmique")'
  38. tt=result
  39. y1=y0+h
  40. x1=x0+ndh*(l%ndh)
  41.  
  42. 'SAVEALL(-1)'
  43. if clip>=0 then 'MENU("Couper")'
  44. /* Tracé des lignes verticales */
  45. select
  46.     when tt=1 then do
  47.     /* Tracé des lignes verticales */
  48.     do i=1 to ndh
  49.         x2 = (x0)+i*(l/ndh)
  50.         x2 = x2%1
  51.         'DRAWMODE(1)'
  52.         do c=1 to 9
  53.         xc = x2-(l/ndh)/10*c
  54.         xc=xc%1
  55.         'DRAW('xc','y0','xc','y1')'
  56.         end
  57.         'DRAWMODE(2):DRAW('x2','y1','x2','y0')'
  58.     end
  59.     end
  60.     when tt=2 then do
  61.     if ~show('L','rexxmathlib.library') then
  62.        call addlib('rexxmathlib.library',0,-30)
  63.     /* Tracé des lignes verticales */
  64.     x2=x0
  65.     do i=1 to ndh
  66.         'DRAWMODE(1)'
  67.         do c=2 to 9
  68.         xc=(l/ndh)*log10(c)
  69.         xc=(x2+xc)%1
  70.         'DRAW('xc','y0','xc','y1')'
  71.         end
  72.         x2 = (x0)+i*(l/ndh)
  73.         x2 = x2%1
  74.         'DRAWMODE(2):DRAW('x2','y1','x2','y0')'
  75.     end
  76.     end
  77.     when tt=3 then do
  78.     if ~show('L','rexxmathlib.library') then
  79.        call addlib('rexxmathlib.library',0,-30)
  80.     x2=x1
  81.     do i=1 to ndh
  82.         'DRAWMODE(2):DRAW('x2','y1','x2','y0')'
  83.         'DRAWMODE(1)'
  84.         do c=2 to 9
  85.         xc=(l/ndh)*log10(c)
  86.         xc=(x2-xc)%1
  87.         'DRAW('xc','y0','xc','y1')'
  88.         end
  89.         x2 = (x1)-i*(l/ndh)
  90.         x2 = x2%1
  91.     end
  92.     end
  93.     otherwise call quitter
  94. end
  95.  
  96. 'ASK("Axe vertical"+CHR(10)+"Nombre de décades?")'
  97. ndv = result
  98. if ndv<=0 then call quitter
  99.  
  100. y1=y0+h
  101. x1=x0+ndh*(l%ndh)
  102. /* Tracé du contour */
  103. 'DRAWMODE(2):DRAW('x0','y0','x1','y0'):DRAW('x0','y1','x0','y0')'
  104.  
  105. 'SELECT("Type d''échelle"+CHR(10)+"1- Linéaire"+CHR(10)+"2- Logarithmique"+CHR(10)+"3- Antilogarithmique")'
  106. tt=result
  107.  
  108. /* Tracé des lignes horizontales */
  109. select
  110.     when tt=1 then do
  111.     do i=1 to ndv
  112.         y2 = (y0)+i*(h/ndv)
  113.         y2 = y2%1
  114.         'DRAWMODE(1)'
  115.         do c=1 to 9
  116.         yc = y2-(h/ndv)/10*c
  117.         yc=yc%1
  118.         'DRAW('x0','yc','x1','yc')'
  119.         end
  120.         'DRAWMODE(2):DRAW('x0','y2','x1','y2')'
  121.     end
  122.     end
  123.     when tt=2 then do
  124.     if ~show('L','rexxmathlib.library') then
  125.        call addlib('rexxmathlib.library',0,-30)
  126.     y2=y1
  127.     do i=1 to ndv
  128.         'DRAWMODE(2):DRAW('x0','y2','x1','y2')'
  129.         'DRAWMODE(1)'
  130.         do c=2 to 9
  131.         yc=(h/ndv)*log10(c)
  132.         yc=(y2-yc)%1
  133.         'DRAW('x0','yc','x1','yc')'
  134.         end
  135.         y2 = y1-i*(h/ndv)
  136.         y2 = y2%1
  137.     end
  138.     end
  139.     when tt=3 then do
  140.     if ~show('L','rexxmathlib.library') then
  141.        call addlib('rexxmathlib.library',0,-30)
  142.  
  143.     y2=y0
  144.  
  145.     do i=1 to ndv
  146.         'DRAWMODE(1)'
  147.         do c=2 to 9
  148.         yc=(h/ndv)*log10(c)
  149.         yc=(y2+yc)%1
  150.         'DRAW('x0','yc','x1','yc')'
  151.         end
  152.         y2 = (y0)+i*(h/ndv)
  153.         y2 = y2%1
  154.         'DRAWMODE(2):DRAW('x0','y2','x1','y2')'
  155.     end
  156.     end
  157.     otherwise call quitter
  158. end
  159. call quitter
  160.  
  161. minima: procedure
  162.     parse arg v1,v2
  163.     if v1<v2 then return v1
  164.     return v2
  165. end
  166.  
  167. maxima: procedure
  168.     parse arg v1,v2
  169.     if v1>v2 then return v1
  170.     return v2
  171. end
  172.  
  173. quitter: procedure expose clip
  174.     if clip>=0 then 'CLIPUNIT('clip')'
  175.     exit
  176.  
  177. /* Traitement des erreurs, interruption du programme */
  178. syntax:
  179. erreur=RC
  180. 'MESSAGE("Script grille.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  181. call quitter
  182.  
  183. error:
  184. 'MESSAGE("Script grille.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
  185. call quitter
  186.